home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / clinic / TimeOut.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-01-26  |  2.5 KB  |  108 lines
  1. unit TimeOut;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls;
  8.  
  9. const
  10.   DefaultTimeOut = 10000;
  11.  
  12. type
  13.   TTimeOut = class(TComponent)
  14.   private
  15.     FTimeOut: Cardinal;
  16.   protected
  17.     procedure SetTimeOut(Value: Cardinal);
  18.     procedure TimerTick(Sender: TObject);
  19.   public
  20.     constructor Create(AOwner: TComponent); override;
  21.     destructor Destroy; override;
  22.   published
  23.     property TimeOut: Cardinal
  24.       read FTimeOut write SetTimeOut default DefaultTimeOut;
  25.   end;
  26.  
  27. procedure Register;
  28.  
  29. implementation
  30.  
  31. var
  32.   hkKb, hkMouse: HHook;
  33.   Timer: TTimer;
  34.  
  35. function HookProc(HHook, Code: Integer; WParam: Cardinal; LParam: Longint): Longint;
  36. begin
  37.   Timer.Enabled := False;
  38.   Timer.Enabled := True;
  39.   Result := CallNextHookEx(HHook, Code, WParam, LParam)
  40. end;
  41.  
  42. function HookProcKB(Code: Integer; WParam: Cardinal; LParam: Longint): Longint;
  43.   {$ifdef Win32}stdcall{$else}far{$endif};
  44. begin
  45.   Result := HookProc(hkKB, Code, WParam, LParam)
  46. end;
  47.  
  48. function HookProcMouse(Code: Integer; WParam: Cardinal; LParam: Longint): Longint;
  49.   {$ifdef Win32}stdcall{$else}far{$endif};
  50. begin
  51.   Result := HookProc(hkMouse, Code, WParam, LParam)
  52. end;
  53.  
  54. const
  55.   Count: Byte = 0;
  56.  
  57. constructor TTimeOut.Create(AOwner: TComponent);
  58. begin
  59.   if Count > 0 then
  60.     raise Exception.Create('Only one of these time-out components allowed');
  61.   Inc(Count);
  62.   inherited Create(AOwner);
  63.   FTimeOut := DefaultTimeout;
  64.   if not (csDesigning in ComponentState) then
  65.   begin
  66.     Timer := TTimer.Create(Self);
  67.     Timer.OnTimer := TimerTick;
  68.     Timer.Interval := FTimeOut;
  69. {$ifdef Win32}
  70.     hkKb := SetWindowsHookEx(wh_Keyboard, @HookProcKB, 0, GetCurrentThreadID);
  71.     hkMouse := SetWindowsHookEx(wh_Mouse, @HookProcMouse, 0, GetCurrentThreadID);
  72. {$else}
  73.     hkKb := SetWindowsHookEx(wh_Keyboard, HookProcKB, HInstance, GetCurrentTask);
  74.     hkMouse := SetWindowsHookEx(wh_Mouse, HookProcMouse, HInstance, GetCurrentTask);
  75. {$endif}
  76.   end;
  77. end;
  78.  
  79. destructor TTimeOut.Destroy;
  80. begin
  81.   if not (csDesigning in ComponentState) then
  82.   begin
  83.     UnhookWindowsHookEx(hkKb);
  84.     UnhookWindowsHookEx(hkMouse)
  85.   end;
  86.   inherited Destroy
  87. end;
  88.  
  89. procedure TTimeOut.SetTimeOut(Value: Cardinal);
  90. begin
  91.   if FTimeOut <> Value then
  92.   begin
  93.     FTimeOut := Value;
  94.     Timer.Interval := Value;
  95.   end
  96. end;
  97.  
  98. procedure TTimeOut.TimerTick(Sender: TObject);
  99. begin
  100.   Application.Terminate
  101. end;
  102.  
  103. procedure Register;
  104. begin
  105.   RegisterComponents('Clinic', [TTimeOut]);
  106. end;
  107.  
  108. end.